home *** CD-ROM | disk | FTP | other *** search
/ Nebula 1 / Nebula One.iso / Internet / WWW / Perl_WWW_Utilities / perlMIF_beta2 / mif / mif_font.pl < prev    next >
Encoding:
Perl Script  |  1994-05-18  |  15.7 KB  |  531 lines
  1. ##---------------------------------------------------------------------------##
  2. ##  File:
  3. ##      mif_font.pl
  4. ##  Author:
  5. ##      Earl Hood       ehood@convex.com
  6. ##  Description:
  7. ##    This file is defines the "mif_font" perl package.  It defines
  8. ##    routines to handle Font/PgfFont via MIFread_mif() defined in
  9. ##    the "mif" package.
  10. ##---------------------------------------------------------------------------##
  11. ##  Copyright (C) 1994  Earl Hood, ehood@convex.com
  12. ##
  13. ##  This program is free software; you can redistribute it and/or modify
  14. ##  it under the terms of the GNU General Public License as published by
  15. ##  the Free Software Foundation; either version 2 of the License, or
  16. ##  (at your option) any later version.
  17. ## 
  18. ##  This program is distributed in the hope that it will be useful,
  19. ##  but WITHOUT ANY WARRANTY; without even the implied warranty of
  20. ##  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21. ##  GNU General Public License for more details.
  22. ##  
  23. ##  You should have received a copy of the GNU General Public License
  24. ##  along with this program; if not, write to the Free Software
  25. ##  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  26. ##---------------------------------------------------------------------------##
  27.  
  28. require 'mif/mif.pl' || die "Unable to require mif.pl\n";
  29.  
  30. package mif_font;
  31.  
  32. ##--------------------------------------##
  33. ## Add Font routines to %MIFToken array ##
  34. ##--------------------------------------##
  35. $mif'MIFToken{'Font'} = "mif_font'Font";
  36. $mif'MIFToken{'PgfFont'} = "mif_font'Font";
  37. @mif'MIFToken{
  38.     'FTag',
  39.     'FFamily',
  40.     'FAngle',
  41.     'FWeight',
  42.     'FVar',
  43.     'FPostScriptName',
  44.     'FPlatformName',
  45.     'FSize',
  46.     'FColor',
  47.     'FUnderline',
  48.     'FDoubleUnderline',
  49.     'FNumericUnderline',
  50.     'FUnderlining',
  51.     'FOverline',
  52.     'FStrike',
  53.     'FSupScript',
  54.     'FSubScript',
  55.     'FChangeBar',
  56.     'FPosition',
  57.     'FOutline',
  58.     'FShadow',
  59.     'FPairKern',
  60.     'FCase',
  61.     'FDX',
  62.     'FDY',
  63.     'FDW',
  64.     'FPlain',
  65.     'FBold',
  66.     'FItalic',
  67.     'FSeparation'
  68. } = (
  69.     "mif_font'FTag",
  70.     "mif_font'FFamily",
  71.     "mif_font'FAngle",
  72.     "mif_font'FWeight",
  73.     "mif_font'FVar",
  74.     "mif_font'FPostScriptName",
  75.     "mif_font'FPlatformName",
  76.     "mif_font'FSize",
  77.     "mif_font'FColor",
  78.     "mif_font'FUnderline",
  79.     "mif_font'FDoubleUnderline",
  80.     "mif_font'FNumericUnderline",
  81.     "mif_font'FUnderlining",
  82.     "mif_font'FOverline",
  83.     "mif_font'FStrike",
  84.     "mif_font'FSupScript",
  85.     "mif_font'FSubScript",
  86.     "mif_font'FChangeBar",
  87.     "mif_font'FPosition",
  88.     "mif_font'FOutline",
  89.     "mif_font'FShadow",
  90.     "mif_font'FPairKern",
  91.     "mif_font'FCase",
  92.     "mif_font'FDX",
  93.     "mif_font'FDY",
  94.     "mif_font'FDW",
  95.     "mif_font'FPlain",
  96.     "mif_font'FBold",
  97.     "mif_font'FItalic",
  98.     "mif_font'FSeparation"
  99. );
  100.  
  101. ##--------------------##
  102. ## mif_font variables ##
  103. ##--------------------##
  104. $fnt_close_func = "";    # Function to call during Font closure.
  105.  
  106. ##---------------------------------------##
  107. ## Variables for current Font definition ##
  108. ##---------------------------------------##
  109. $fnt_Token    = "";
  110. $fnt_Tag    = "";
  111. $fnt_Family    = "";
  112. $fnt_Angle    = "";
  113. $fnt_Weight    = "";
  114. $fnt_Var    = "";
  115. $fnt_PostScriptName = "";
  116. $fnt_PlatformName = "";
  117. $fnt_Size    = "";
  118. $fnt_Color    = "";
  119. $fnt_Underline    = "";
  120. $fnt_DoubleUnderline = "";
  121. $fnt_NumericUnderline = "";
  122. $fnt_Underlining = "";
  123. $fnt_Overline    = "";
  124. $fnt_Strike    = "";
  125. $fnt_SupScript    = "";
  126. $fnt_SubScript    = "";
  127. $fnt_ChangeBar    = "";
  128. $fnt_Position    = "";
  129. $fnt_Outline    = "";
  130. $fnt_Shadow    = "";
  131. $fnt_PairKern    = "";
  132. $fnt_Case    = "";
  133. $fnt_DX        = "";
  134. $fnt_DY        = "";
  135. $fnt_DW        = "";
  136. $fnt_Plain    = "";
  137. $fnt_Bold    = "";
  138. $fnt_Italic    = "";
  139. $fnt_Separation    = "";
  140.  
  141. ##------------------------##
  142. ## Import 'mif' variables ##
  143. ##------------------------##
  144. $MStore        = $mif'MStore;
  145. $MOpen        = $mif'MOpen;
  146. $MClose        = $mif'MClose;
  147. $MLine        = $mif'MLine;
  148. $mso        = $mif'mso;
  149. $msc        = $mif'msc;
  150. $stb        = $mif'stb;
  151. $ste        = $mif'ste;
  152. $como        = $mif'como;
  153.  
  154.                 ##---------------##
  155.                 ## Main Routines ##
  156.                 ##---------------##
  157. ##---------------------------------------------------------------------------
  158. ##    MIFget_font_func() returns the function that is called when the
  159. ##    Font/PgfFont statement closes.
  160. ##
  161. ##    Usage:
  162. ##        $func = &'MIFget_font_func();
  163. ##
  164. sub main'MIFget_font_func {
  165.     $fnt_close_func;
  166. }
  167. ##---------------------------------------------------------------------------
  168. ##    MIFset_font_func() sets the function that is called when the
  169. ##    Font/PgfFont statement closes.
  170. ##
  171. ##    Usage:
  172. ##        &'MIFset_font_func($func);
  173. ##
  174. sub main'MIFset_font_func {
  175.     $fnt_close_func = $_[0];
  176. }
  177. ##---------------------------------------------------------------------------
  178. ##    MIFwrite_font() outputs the Font/PgfFont in MIF.
  179. ##
  180. ##    Usage:
  181. ##        &'MIFwrite_font(FILEHANDLE, $indent, $FontToken, <font vars ...>);
  182. ##
  183. sub main'MIFwrite_font {
  184.     local($handle, $l, $Font, 
  185.       $Tag,
  186.       $Family,
  187.       $Angle,
  188.       $Weight,
  189.       $Var,
  190.       $PostScriptName,
  191.       $PlatformName,
  192.       $Size,
  193.       $Color,
  194.       $Underline,
  195.       $DoubleUnderline,
  196.       $NumericUnderline,
  197.       $Underlining,
  198.       $Overline,
  199.       $Strike,
  200.       $SupScript,
  201.       $SubScript,
  202.       $ChangeBar,
  203.       $Position,
  204.       $Outline,
  205.       $Shadow,
  206.       $PairKern,
  207.       $Case,
  208.       $DX,
  209.       $DY,
  210.       $DW,
  211.       $Plain,
  212.       $Bold,
  213.       $Italic,
  214.       $Separation) = @_;
  215.     local($i0, $i1, $i2) = (' ' x $l, ' ' x (1+$l), ' ' x (2+$l));
  216.  
  217.     print $handle $i0, $mso, "$Font\n";
  218.     print $handle $i1, $mso, 'FTag ', $stb, $Tag, $ste, $msc, "\n";
  219.     print $handle $i1, $mso, 'FFamily ', $stb, $Family, $ste, $msc, "\n"
  220.     if $Family ne "";
  221.     print $handle $i1, $mso, 'FVar ', $stb, $Var, $ste, $msc, "\n"
  222.     if $Var ne "";
  223.     print $handle $i1, $mso, 'FWeight ', $stb, $Weight, $ste, $msc, "\n"
  224.     if $Weight ne "";
  225.     print $handle $i1, $mso, 'FAngle ', $stb, $Angle, $ste, $msc, "\n"
  226.     if $Angle ne "";
  227.     print $handle $i1, $mso, 'FPostScriptName ', $stb, $PostScriptName, $ste,
  228.                $msc, "\n"
  229.     if $PostScriptName ne "";
  230.     print $handle $i1, $mso, 'FPlatformName ', $PlatformName, $msc, "\n"
  231.     if $PlatformName ne "";
  232.     print $handle $i1, $mso, 'FSize ', $Size, $msc, "\n"
  233.     if $Size ne "";
  234.     print $handle $i1, $mso, 'FUnderlining ', $Underlining, $msc, "\n"
  235.     if $Underlining ne "";
  236.     print $handle $i1, $mso, 'FUnderline ', $Underline, $msc, "\n"
  237.     if $Underline ne "";
  238.     print $handle $i1, $mso, 'FDoubleUnderline ', $DoubleUnderline, $msc, "\n"
  239.     if $DoubleUnderline ne "";
  240.     print $handle $i1, $mso, 'FNumericUnderline ', $NumericUnderline, $msc, "\n"
  241.     if $NumericUnderline ne "";
  242.     print $handle $i1, $mso, 'FOverline ', $Overline, $msc, "\n"
  243.     if $Overline ne "";
  244.     print $handle $i1, $mso, 'FStrike ', $Strike, $msc, "\n"
  245.     if $Strike ne "";
  246.     print $handle $i1, $mso, 'FChangeBar ', $ChangeBar, $msc, "\n"
  247.     if $ChangeBar ne "";
  248.     print $handle $i1, $mso, 'FOutline ', $Outline, $msc, "\n"
  249.     if $Outline ne "";
  250.     print $handle $i1, $mso, 'FShadow ', $Shadow, $msc, "\n"
  251.     if $Shadow ne "";
  252.     print $handle $i1, $mso, 'FPairKern ', $PairKern, $msc, "\n"
  253.     if $PairKern ne "";
  254.     print $handle $i1, $mso, 'FCase ', $Case, $msc, "\n"
  255.     if $Case ne "";
  256.     print $handle $i1, $mso, 'FPosition ', $Position, $msc, "\n"
  257.     if $Position ne "";
  258.     print $handle $i1, $mso, 'FSupScript ', $SupScript, $msc, "\n"
  259.     if $SupScript ne "";
  260.     print $handle $i1, $mso, 'FSubScript ', $SubScript, $msc, "\n"
  261.     if $SubScript ne "";
  262.     print $handle $i1, $mso, 'FDX ', $DX, $msc, "\n"
  263.     if $DX ne "";
  264.     print $handle $i1, $mso, 'FDY ', $DY, $msc, "\n"
  265.     if $DY ne "";
  266.     print $handle $i1, $mso, 'FDW ', $DW, $msc, "\n"
  267.     if $DW ne "";
  268.     print $handle $i1, $mso, 'FPlain ', $Plain, $msc, "\n"
  269.     if $Plain ne "";
  270.     print $handle $i1, $mso, 'FBold ', $Bold, $msc, "\n"
  271.     if $Bold ne "";
  272.     print $handle $i1, $mso, 'FItalic ', $Italic, $msc, "\n"
  273.     if $Italic ne "";
  274.     print $handle $i1, $mso, 'FSeparation ', $Separation, $msc, "\n"
  275.     if $Separation ne "";
  276.     print $handle $i1, $mso, 'FColor ', $stb, $Color, $ste, $msc, "\n"
  277.     if $Color ne "";
  278.     print $handle $i0, $msc, " $como end of $Font\n";
  279. }
  280. ##---------------------------------------------------------------------------##
  281. ##    MIFget_last_font_data() is a convienence routine that returns the
  282. ##    data associated with the last Font/PgfFont statement.  This routine
  283. ##    is mainly used by other mif_* libraries that need to process
  284. ##    Font/PgfFont statements (eg. mif_fntc, mif_pgfc).
  285. ##
  286. ##    Usage:
  287. ##        @array = &'MIFget_last_font_data();
  288. ##
  289. sub main'MIFget_last_font_data {
  290.     ($fnt_Token,
  291.      $fnt_Tag,
  292.      $fnt_Family,
  293.      $fnt_Angle,
  294.      $fnt_Weight,
  295.      $fnt_Var,
  296.      $fnt_PostScriptName,
  297.      $fnt_PlatformName,
  298.      $fnt_Size,
  299.      $fnt_Color,
  300.      $fnt_Underline,
  301.      $fnt_DoubleUnderline,
  302.      $fnt_NumericUnderline,
  303.      $fnt_Underlining,
  304.      $fnt_Overline,
  305.      $fnt_Strike,
  306.      $fnt_SupScript,
  307.      $fnt_SubScript,
  308.      $fnt_ChangeBar,
  309.      $fnt_Position,
  310.      $fnt_Outline,
  311.      $fnt_Shadow,
  312.      $fnt_PairKern,
  313.      $fnt_Case,
  314.      $fnt_DX,
  315.      $fnt_DY,
  316.      $fnt_DW,
  317.      $fnt_Plain,
  318.      $fnt_Bold,
  319.      $fnt_Italic,
  320.      $fnt_Separation);
  321. }
  322. ##---------------------------------------------------------------------------##
  323.                 ##--------------##
  324.                 ## Mif Routines ##
  325.                 ##--------------##
  326. ##---------------------------------------------------------------------------##
  327. ##    The routines definded below are all registered in the %MIFToken         ##
  328. ##    array for use in the MIFread_mif() routine.  There purpose is to     ##
  329. ##    store the information contained in Font/PgfFont statement.         ##
  330. ##---------------------------------------------------------------------------##
  331.  
  332. ##---------------------------------------------------------------------------
  333. sub Font {
  334.     local($token, $mode, *data) = @_;
  335.  
  336.     if ($mode == $MOpen) {
  337.     $fnt_Token = $token;
  338.     $fnt_Tag = "";
  339.     $fnt_Family = "";
  340.     $fnt_Angle = "";
  341.     $fnt_Weight = "";
  342.     $fnt_Var = "";
  343.     $fnt_PostScriptName = "";
  344.     $fnt_PlatformName = "";
  345.     $fnt_Size = "";
  346.     $fnt_Color = "";
  347.     $fnt_Underline = "";
  348.     $fnt_DoubleUnderline = "";
  349.     $fnt_NumericUnderline = "";
  350.     $fnt_Underlining = "";
  351.     $fnt_Overline = "";
  352.     $fnt_Strike = "";
  353.     $fnt_SupScript = "";
  354.     $fnt_SubScript = "";
  355.     $fnt_ChangeBar = "";
  356.     $fnt_Position = "";
  357.     $fnt_Outline = "";
  358.     $fnt_Shadow = "";
  359.     $fnt_PairKern = "";
  360.     $fnt_Case = "";
  361.     $fnt_DX    = "";
  362.     $fnt_DY    = "";
  363.     $fnt_DW    = "";
  364.     $fnt_Plain = "";
  365.     $fnt_Bold = "";
  366.     $fnt_Italic = "";
  367.     $fnt_Separation = "";
  368.     } elsif ($mode == $MClose) {
  369.     &$fnt_close_func() if $fnt_close_func;
  370.     } else {
  371.     warn "Unexpected mode, $mode, passed to Font routine\n";
  372.     }
  373. }
  374. ##---------------------------------------------------------------------------
  375. sub FTag {
  376.     local($token, $mode, *data) = @_;
  377.     ($fnt_Tag) = $data =~ /^\s*$stb([^$ste]*)$ste.*$/o;
  378. }
  379. ##---------------------------------------------------------------------------
  380. sub FFamily {
  381.     local($token, $mode, *data) = @_;
  382.     ($fnt_Family) = $data =~ /^\s*$stb([^$ste]*)$ste.*$/o;
  383. }
  384. ##---------------------------------------------------------------------------
  385. sub FAngle {
  386.     local($token, $mode, *data) = @_;
  387.     ($fnt_Angle) = $data =~ /^\s*$stb([^$ste]*)$ste.*$/o;
  388. }
  389. ##---------------------------------------------------------------------------
  390. sub FWeight {
  391.     local($token, $mode, *data) = @_;
  392.     ($fnt_Weight) = $data =~ /^\s*$stb([^$ste]*)$ste.*$/o;
  393. }
  394. ##---------------------------------------------------------------------------
  395. sub FVar {
  396.     local($token, $mode, *data) = @_;
  397.     ($fnt_Var) = $data =~ /^\s*$stb([^$ste]*)$ste.*$/o;
  398. }
  399. ##---------------------------------------------------------------------------
  400. sub FPostScriptName {
  401.     local($token, $mode, *data) = @_;
  402.     ($fnt_PostScriptName) = $data =~ /^\s*$stb([^$ste]*)$ste.*$/o;
  403. }
  404. ##---------------------------------------------------------------------------
  405. sub FColor {
  406.     local($token, $mode, *data) = @_;
  407.     ($fnt_Color) = $data =~ /^\s*$stb([^$ste]*)$ste.*$/o;
  408. }
  409. ##---------------------------------------------------------------------------
  410. sub FSize {
  411.     local($token, $mode, *data) = @_;
  412.     ($fnt_Size) = $data =~ /^\s*(.*)$/o;
  413. }
  414. ##---------------------------------------------------------------------------
  415. sub FUnderline {
  416.     local($token, $mode, *data) = @_;
  417.     ($fnt_Underline) = $data =~ /^\s*(.*)$/o;
  418. }
  419. ##---------------------------------------------------------------------------
  420. sub FDoubleUnderline {
  421.     local($token, $mode, *data) = @_;
  422.     ($fnt_DoubleUnderline) = $data =~ /^\s*(.*)$/o;
  423. }
  424. ##---------------------------------------------------------------------------
  425. sub FNumericUnderline {
  426.     local($token, $mode, *data) = @_;
  427.     ($fnt_NumericUnderline) = $data =~ /^\s*(.*)$/o;
  428. }
  429. ##---------------------------------------------------------------------------
  430. sub FUnderlining {
  431.     local($token, $mode, *data) = @_;
  432.     ($fnt_Underlining) = $data =~ /^\s*(.*)$/o;
  433. }
  434. ##---------------------------------------------------------------------------
  435. sub FOverline {
  436.     local($token, $mode, *data) = @_;
  437.     ($fnt_Overline) = $data =~ /^\s*(.*)$/o;
  438. }
  439. ##---------------------------------------------------------------------------
  440. sub FStrike {
  441.     local($token, $mode, *data) = @_;
  442.     ($fnt_Strike) = $data =~ /^\s*(.*)$/o;
  443. }
  444. ##---------------------------------------------------------------------------
  445. sub FSupScript {
  446.     local($token, $mode, *data) = @_;
  447.     ($fnt_SupScript) = $data =~ /^\s*(.*)$/o;
  448. }
  449. ##---------------------------------------------------------------------------
  450. sub FSubScript {
  451.     local($token, $mode, *data) = @_;
  452.     ($fnt_SubScript) = $data =~ /^\s*(.*)$/o;
  453. }
  454. ##---------------------------------------------------------------------------
  455. sub FChangeBar {
  456.     local($token, $mode, *data) = @_;
  457.     ($fnt_ChangeBar) = $data =~ /^\s*(.*)$/o;
  458. }
  459. ##---------------------------------------------------------------------------
  460. sub FPosition {
  461.     local($token, $mode, *data) = @_;
  462.     ($fnt_Position) = $data =~ /^\s*(.*)$/o;
  463. }
  464. ##---------------------------------------------------------------------------
  465. sub FOutline {
  466.     local($token, $mode, *data) = @_;
  467.     ($fnt_Outline) = $data =~ /^\s*(.*)$/o;
  468. }
  469. ##---------------------------------------------------------------------------
  470. sub FShadow {
  471.     local($token, $mode, *data) = @_;
  472.     ($fnt_Shadow) = $data =~ /^\s*(.*)$/o;
  473. }
  474. ##---------------------------------------------------------------------------
  475. sub FPairKern {
  476.     local($token, $mode, *data) = @_;
  477.     ($fnt_PairKern) = $data =~ /^\s*(.*)$/o;
  478. }
  479. ##---------------------------------------------------------------------------
  480. sub FCase {
  481.     local($token, $mode, *data) = @_;
  482.     ($fnt_Case) = $data =~ /^\s*(.*)$/o;
  483. }
  484. ##---------------------------------------------------------------------------
  485. sub FDX {
  486.     local($token, $mode, *data) = @_;
  487.     ($fnt_DX) = $data =~ /^\s*(.*)$/o;
  488. }
  489. ##---------------------------------------------------------------------------
  490. sub FDY {
  491.     local($token, $mode, *data) = @_;
  492.     ($fnt_DY) = $data =~ /^\s*(.*)$/o;
  493. }
  494. ##---------------------------------------------------------------------------
  495. sub FDW {
  496.     local($token, $mode, *data) = @_;
  497.     ($fnt_DW) = $data =~ /^\s*(.*)$/o;
  498. }
  499. ##---------------------------------------------------------------------------
  500. sub FPlain {
  501.     local($token, $mode, *data) = @_;
  502.     ($fnt_Plain) = $data =~ /^\s*(.*)$/o;
  503. }
  504. ##---------------------------------------------------------------------------
  505. sub FBold {
  506.     local($token, $mode, *data) = @_;
  507.     ($fnt_Bold) = $data =~ /^\s*(.*)$/o;
  508. }
  509. ##---------------------------------------------------------------------------
  510. sub FItalic {
  511.     local($token, $mode, *data) = @_;
  512.     ($fnt_Italic) = $data =~ /^\s*(.*)$/o;
  513. }
  514. ##---------------------------------------------------------------------------
  515. sub FSeparation {
  516.     local($token, $mode, *data) = @_;
  517.     ($fnt_Separation) = $data =~ /^\s*(.*)$/o;
  518. }
  519. ##---------------------------------------------------------------------------
  520. sub FColor {
  521.     local($token, $mode, *data) = @_;
  522.     ($fnt_Color) = $data =~ /^\s*$stb([^$ste]*)$ste.*$/o;
  523. }
  524. ##---------------------------------------------------------------------------
  525. sub FPlatformName {
  526.     local($token, $mode, *data) = @_;
  527.     ($fnt_PlatformName) = $data =~ /^\s*(.*)$/o;
  528. }
  529. ##---------------------------------------------------------------------------
  530. 1;
  531.